home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b1.d64 / fetch.l < prev    next >
Text File  |  2007-02-28  |  1KB  |  44 lines
  1. 9000 //
  2. 9010 PROC FETCH(REF A$,V$,MAX) CLOSED
  3. 9030 DIM VALID$ OF 40, B$ OF 1
  4. 9040 // IF V$ = "A" THEN THE ALPHABET IS USED (PLUS SPACE)
  5. 9050 // IF V$ = "D" THEN THE DIGITS ARE USED
  6. 9060 // IF V$ = "B" THEN BOTH ALPHABET AND DIGITS ARE USED (PLUS SPACE)
  7. 9070 // OTHERWISE VALID$ IS SET TO THE VALUE AS SENT
  8. 9080 // NOTE: >>> CARRIAGE RETURN AND DELETE KEY ARE ADDED TO VALID$
  9. 9090 Z:=ZONE
  10. 9100 ZONE 0
  11. 9110 A$:=""
  12. 9120 CASE V$ OF
  13. 9130 WHEN "A"
  14. 9140 VALID$:="ABCDEFGHIJKLMNOPQRSTUVWXYZ "
  15. 9150 WHEN "D"
  16. 9160 VALID$:="0123456789"
  17. 9170 WHEN "B"
  18. 9180 VALID$:="ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789"
  19. 9190 OTHERWISE 
  20. 9200 VALID$:=V$
  21. 9210 ENDCASE 
  22. 9220 DONE:=FALSE; NUM:=0
  23. 9230 REPEAT 
  24. 9240 GET'VALID(B$,VALID$+CHR$(13)+CHR$(20))
  25. 9250 CASE B$ OF
  26. 9260 WHEN CHR$(13) // CARRIAGE RETURN
  27. 9270 DONE:=TRUE
  28. 9280 WHEN CHR$(20) // DELETE KEY
  29. 9290 IF NUM THEN // ONLY DO IF ALREADY HAVE SOMETHING
  30. 9300 NUM:-1 //    MINUS ONE FOR NUMBER IN STRING
  31. 9310 PRINT "¥ ¥", // CURSOR LEFT SPACE CURSOR LEFT
  32. 9320 A$:=A$(1:NUM)
  33. 9330 ENDIF 
  34. 9340 OTHERWISE  //    ALL OTHER VALID CHARACTERS
  35. 9350 IF NUM<MAX THEN // DON'T GO PAST MAXIMUM
  36. 9360 A$:=A$+B$ //  ADD CHARACTER TO THE STRINGRETURN NEEDED
  37. 9370 NUM:+1 //     ADD 1 TO THE COUNT OF CHARACTERS
  38. 9380 PRINT B$, //  PRINT THE CHARACTER
  39. 9390 ENDIF 
  40. 9400 ENDCASE 
  41. 9410 UNTIL DONE
  42. 9420 ZONE Z
  43. 9430 ENDPROC FETCH
  44.